home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0058_PCX Files.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  16KB  |  461 lines

  1.  
  2. unit PCX;
  3.  
  4. {   The following display modes are supported:
  5.  
  6.           Mode      TP GraphMode     Resolution    Colors
  7.           ~~~~      ~~~~~~~~~~~~     ~~~~~~~~~~    ~~~~~~
  8.           $04       CGAC0 to C3      320 x 200         4
  9.           $06       CGAHi            640 x 200         2
  10.           $0D        ---             320 x 200        16
  11.           $0E       EGALo/VGALo      640 x 200        16
  12.           $10       EGAHi/VGAMed     640 x 350        16
  13.           $12       VGAHi            640 x 480        16
  14.           $13        ---             320 x 200       256
  15.  
  16.    Mode $13 is supported only for files containing palette information,
  17.    i.e. not those produced by versions of Paintbrush earlier than 3.0.}
  18.  
  19. INTERFACE
  20.  
  21. uses DOS, GRAPH;
  22.  
  23. type    RGBrec = record
  24.                    redval, greenval, blueval: byte;
  25.                  end;
  26.  
  27. var     pcxfilename: pathstr;
  28.         file_error: boolean;
  29.         pal: palettetype;
  30.         RGBpal: array[0..15] of RGBrec;
  31.         RGB256: array[0..255] of RGBrec;
  32.         page_addr: word;
  33.         bytes_per_line: word;
  34.         buff0, buff1: pointer;
  35.  
  36.         { CGA display memory banks: }
  37.         screenbuff0: array[0..7999] of byte absolute $b800:$0000;
  38.         screenbuff1: array[0..7999] of byte absolute $b800:$2000;
  39.  
  40. const   page0 = $A000;           { EGA/VGA display segment }
  41.  
  42. procedure SETMODE(mode: byte);
  43. procedure SETREGISTERS(var palrec);
  44. procedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);
  45. procedure READ_PCX256(pfilename: pathstr);
  46.  
  47. {========================================================================}
  48.  
  49. IMPLEMENTATION
  50.  
  51. var     scratch, abuff0, abuff1: pointer;
  52.         is_CGA, is_VGA: boolean;
  53.         repeatcount: byte;
  54.         datalength: word;
  55.         columncount, plane, video_index: word;
  56.         regs: registers;
  57.  
  58. const   buffsize = 65521;   { Largest possible }
  59.  
  60. { -------------------------- BIOS calls --------------------------------- }
  61.  
  62. { For modes not supported by the BGI, use SetMode to initialize the
  63.   graphics. Since SetRGBPalette won't work if Turbo hasn't done the
  64.   graphics initialization itself, use SetRegisters to change the colors
  65.   in mode $13. }
  66.  
  67. procedure SETMODE(mode: byte);
  68.  
  69. begin
  70. regs.ah:= 0;                 { BIOS set mode function }
  71. regs.al:= mode;              { Display mode }
  72. intr($10, regs);             { Call BIOS }
  73. end;
  74.  
  75. procedure SETREGISTERS(var palrec);
  76.  
  77. { Palrec is any string of 768 bytes containing the RGB data. }
  78.  
  79. begin
  80. regs.ah:= $10;               { BIOS color register function }
  81. regs.al:= $12;               { Subfunction }
  82. regs.es:= seg(palrec);       { Address of palette info. }
  83. regs.dx:= ofs(palrec);
  84. regs.bx:= 0;                 { First register to change }
  85. regs.cx:= $100;              { Number of registers to change }
  86. intr($10, regs);             { Call BIOS }
  87. end;
  88.  
  89. { ====================== EGA/VGA 16-color files ========================= }
  90.  
  91. procedure DECODE_16; assembler;
  92.  
  93. asm
  94. push    bp
  95.  
  96. { ----------------- Assembler procedure for 16-color files -------------- }
  97.  
  98. { The first section is initialization done on each run through the
  99.   input buffer. }
  100.  
  101. @startproc:
  102. mov     bp, plane           { plane in BP }
  103. mov     es, page_addr       { video display segment }
  104. mov     di, video_index     { index into video segment }
  105. mov     ah, byte ptr bytes_per_line  { line length in AH }
  106. mov     dx, columncount     { column counter }
  107. mov     bx, datalength      { no. of bytes to read }
  108. xor     cx, cx              { clean up CX for loop counter }
  109. mov     cl, repeatcount     { count in CX }
  110. push    ds                  { save DS }
  111. lds     si, scratch         { input buffer pointer in DS:SI }
  112. add     bx, si
  113. cld                         { clear DF for stosb }
  114. cmp     cl, 0               { was last byte a count? }
  115. jne     @multi_data         { yes, so next is data }
  116. jmp     @getbyte            { no, so find out what next is }
  117.  
  118. { -------------- Procedure to write EGA/VGA image to video -------------- }
  119.  
  120. @writebyte:
  121. stosb                       { AL into ES:DI, inc DI }
  122. inc     dl                  { increment column }
  123. cmp     dl, ah              { reached end of scanline? }
  124. je      @doneline           { yes }
  125. loop    @writebyte          { no, do another }
  126. jmp     @getbyte            {   or get more data }
  127. @doneline:
  128. shl     bp, 1               { shift to next plane }
  129. cmp     bp, 8               { done 4 planes? }
  130. jle     @setindex           { no }
  131. mov     bp, 1               { yes, reset plane to 1 but don't reset index }
  132. jmp     @setplane
  133. @setindex:
  134. sub     di, dx              { reset to start of line }
  135. @setplane:
  136. push    ax                  { save AX }
  137. cli                         { no interrupts }
  138. mov     ax, bp              { plane is 1, 2, 4, or 8 }
  139. mov     dx, 3C5h            { sequencer data register }
  140. out     dx, al              { mask out 3 planes }
  141. sti                         { enable interrupts }
  142. pop     ax                  { restore AX }
  143. xor     dx, dx              { reset column count }
  144. loop    @writebyte          { do it again, or fetch more data }
  145.  
  146. @getbyte:                   { last byte was not a count }
  147. cmp     si, bx              { end of input buffer? }
  148. je      @exit               { yes, quit }
  149. lodsb                       { get a byte from DS:SI into AL, increment SI }
  150. cmp     al, 192             { test high bits }
  151. jb      @one_data           { not set, it's data to be written once }
  152.  { It's a count byte: }
  153. xor     al, 192             { get count from 6 low bits }
  154. mov     cl, al              { store repeat count }
  155. cmp     si, bx              { end of input buffer? }
  156. je      @exit               { yes, quit }
  157. @multi_data:
  158. lodsb                       { get data byte }
  159. jmp     @writebyte          { write it CL times }
  160. @one_data:
  161. mov     cl, 1               { write byte once }
  162. jmp     @writebyte
  163.  
  164. { ---------------------- Finished with buffer --------------------------- }
  165.  
  166. @exit:
  167. pop     ds                  { restore Turbo's data segment }
  168. mov     plane, bp           { save status for next run thru buffer }
  169. mov     repeatcount, cl
  170. mov     columncount, dx
  171. mov     video_index, di
  172. pop     bp
  173. end;  { asm }
  174.  
  175. { ===================== CGA 2- and 4-color files ======================== }
  176.  
  177. procedure DECODE_CGA; assembler;
  178.  
  179. asm
  180.  
  181. push    bp
  182. jmp     @startproc
  183.  
  184. { ------------- Procedure to store CGA image in buffers ----------------- }
  185.  
  186. @storebyte:
  187. stosb                       { AL into ES:DI, increment DI }
  188. inc     dx                  { increment column count }
  189. cmp     dl, ah              { reached end of line? }
  190. je      @row_ends           { yes }
  191. loop    @storebyte          { not end of row, do another byte }
  192. ret
  193. @row_ends:
  194. xor     bp, 1               { switch banks }
  195. cmp     bp, 1               { is bank 1? }
  196. je      @bank1              { yes }
  197. mov     word ptr abuff1, di { no, save index into bank 1 }
  198. les     di, abuff0          { bank 0 pointer into ES:DI }
  199. xor     dx, dx              { reset column counter }
  200. loop    @storebyte
  201. ret
  202. @bank1:
  203. mov     word ptr abuff0, di { save index into bank 0 }
  204. les     di, abuff1          { bank 1 pointer into ES:DI }
  205. xor     dx, dx              { reset column counter }
  206. loop    @storebyte
  207. ret
  208.  
  209. { ---------------- Main assembler procedure for CGA --------------------- }
  210.  
  211. @startproc:
  212. mov     bp, 0                        { bank in BP }
  213. mov     es, word ptr abuff0[2]       { segment of bank 0 buffer }
  214. mov     di, word ptr abuff0          { offset of buffer }
  215. mov     ah, byte ptr bytes_per_line  { line length in AH }
  216. mov     bx, datalength               { no. of bytes to read }
  217. xor     cx, cx                       { clean up CX for loop counter }
  218. xor     dx, dx                       { initialize column counter }
  219. mov     si, dx                       { initialize input index }
  220. cld                                  { clear DF for stosb }
  221.  
  222. { -------------------- Loop through input buffer ------------------------ }
  223.  
  224. @getbyte:
  225. cmp     si, bx              { end of input buffer? }
  226. je      @exit               { yes, quit }
  227. push    es                  { save output pointer }
  228. push    di
  229. les     di, scratch         { get input pointer in ES:DI }
  230. add     di, si              { add current offset }
  231. mov     al, [es:di]         { get a byte }
  232. inc     si                  { advance input index }
  233. pop     di                  { restore output pointer }
  234. pop     es
  235. cmp     cl, 0               { was previous byte a count? }
  236. jg      @multi_data         { yes, this is data }
  237. cmp     al, 192             { no, test high bits }
  238. jb      @one_data           { not set, not a count }
  239.  { It's a count byte: }
  240. xor     al, 192             { get count from 6 low bits }
  241. mov     cl, al              { store repeat count }
  242. jmp     @getbyte            { go get data byte }
  243. @one_data:
  244. mov     cl, 1               { write byte once }
  245. call    @storebyte
  246. jmp     @getbyte
  247. @multi_data:
  248. call    @storebyte          { CL already set }
  249. jmp     @getbyte
  250.  
  251. { ---------------------- Finished with buffer --------------------------- }
  252.  
  253. @exit:
  254. pop     bp
  255. end;  { asm }
  256.  
  257. { ============= Main procedure for CGA and 16-color files =============== }
  258.  
  259. procedure READ_PCX_FILE(gdriver: integer; pfilename: pathstr);
  260.  
  261. type    ptrrec = record
  262.                    segm, offs: word;
  263.                  end;
  264.  
  265. var     entry, gun, pcxcode, mask, colorID: byte;
  266.         palbuf: array[0..66] of byte;
  267.         pcxfile: file;
  268.  
  269. begin   { READ_PCX_FILE }
  270. is_CGA:= (gdriver = CGA);   { 2 or 4 colors }
  271. is_VGA:= (gdriver = VGA);   { 16 of 256K possible colors }
  272.                             { Otherwise EGA - 16 of 64 possible colors }
  273. assign(pcxfile, pfilename);
  274. {$I-} reset(pcxfile, 1);  {$I+}
  275. file_error:= (IOresult <> 0);
  276. if file_error then exit;
  277.  
  278. getmem(scratch, buffsize);                 { Allocate scratchpad }
  279. blockread(pcxfile, scratch^, 128);         { Get header into scratchpad }
  280.  
  281. move(scratch^, palbuf, 67);
  282. bytes_per_line:= palbuf[66];
  283.  
  284. {------------------------ Setup for CGA ---------------------------------}
  285.  
  286. if is_CGA then
  287. begin
  288.   getmem(buff0, 8000);      { Allocate memory for output }
  289.   getmem(buff1, 8000);
  290.   abuff0:= buff0;           { Make copies of pointers }
  291.   abuff1:= buff1;
  292. end else
  293.  
  294. {----------------------- Setup for EGA/VGA ------------------------------}
  295.  
  296. begin
  297.   video_index:= 0;
  298.   port[$3C4]:= 2;           { Index to map mask register }
  299.   plane:= 1;                { Initialize plane }
  300.   port[$3C5]:= plane;       { Set sequencer to mask out other planes }
  301.  
  302.   for entry:= 0 to 15 do
  303.   begin
  304.     colorID:= 0;
  305.     for gun:= 0 to 2 do
  306.     begin
  307.       pcxcode:= palbuf[16 + entry * 3 + gun];   { Get primary color value }
  308.       if not is_VGA then
  309.       begin                                     { Interpret for EGA }
  310.         case (pcxcode div $40) of
  311.           0: mask:= $00;    { 000000 }
  312.           1: mask:= $20;    { 100000 }
  313.           2: mask:= $04;    { 000100 }
  314.           3: mask:= $24;    { 100100 }
  315.         end;
  316.         colorID:= colorID or (mask shr gun);    { Define two bits }
  317.       end  { not is_VGA }
  318.       else
  319.       begin  { is_VGA }
  320.         with RGBpal[entry] do                   { Interpret for VGA }
  321.         case gun of
  322.           0: redval:= pcxcode div 4;
  323.           1: greenval:= pcxcode div 4;
  324.           2: blueval:= pcxcode div 4;
  325.         end;
  326.       end;  { is_VGA }
  327.     end;  { gun }
  328.     if is_VGA then pal.colors[entry]:= entry
  329.               else pal.colors[entry]:= colorID;
  330.   end;  { entry }
  331.   pal.size:= 16;
  332. end;   { not is_CGA }
  333.  
  334. { ---------------- Read and decode the image data ----------------------- }
  335.  
  336. repeatcount:= 0;                        { Initialize assembler vars. }
  337. columncount:= 0;
  338. repeat
  339.   blockread(pcxfile, scratch^, buffsize, datalength);
  340.   if is_CGA then decode_CGA else decode_16;   { Call assembler routine }
  341. until eof(pcxfile);
  342. close(pcxfile);
  343. if not is_CGA then port[$3C5]:= $F;     { Reset mask map }
  344. freemem(scratch,buffsize);              { Discard scratchpad }
  345. end;  { READ_PCX_FILE }
  346.  
  347. { ========================= 256-color files ============================= }
  348.  
  349. procedure DECODE_PCX256; assembler;
  350.  
  351. asm
  352. mov     es, page_addr       { video segment }
  353. mov     di, video_index     { index into video }
  354. xor     cx, cx              { clean up loop counter }
  355. mov     cl, repeatcount     { count in CL }
  356. mov     bx, datalength      { end of input buffer }
  357. push    ds                  { save DS }
  358. lds     si, scratch         { pointer to input in DS:SI }
  359. add     bx, si              { adjust datalength - SI may not be 0 }
  360. cld                         { clear DF }
  361. cmp     cl, 0               { was last byte a count? }
  362. jne     @multi_data         { yes, so next is data }
  363.  
  364. { --------------------- Loop through input buffer ----------------------- }
  365.  
  366. @getbyte:                   { last byte was not a count }
  367. cmp     si, bx              { end of input buffer? }
  368. je      @exit               { yes, quit }
  369. lodsb                       { get byte into AL, increment SI }
  370. cmp     al, 192             { test high bits }
  371. jb      @one_data           { not set, not a count }
  372. { It's a count byte }
  373. xor     al, 192             { get count from 6 low bits }
  374. mov     cl, al              { store repeat count }
  375. cmp     si, bx              { end of input buffer? }
  376. je      @exit               { yes, quit }
  377. @multi_data:
  378. lodsb                       { get byte into AL, increment SI }
  379. rep     stosb               { write byte CX times }
  380. jmp     @getbyte
  381. @one_data:
  382. stosb                       { byte into video }
  383. jmp     @getbyte
  384.  
  385. { ------------------------- Finished with buffer ------------------------ }
  386.  
  387. @exit:
  388. pop     ds                  { restore Turbo's data segment }
  389. mov     video_index, di     { save status for next run thru buffer }
  390. mov     repeatcount, cl
  391. end;  { asm }
  392.  
  393. { ================= Main procedure for 256-color files ================== }
  394.  
  395. procedure READ_PCX256(pfilename: pathstr);
  396.  
  397. var     x, gun, pcxcode: byte;
  398.         pcxfile: file;
  399.         palette_start, total_read: longint;
  400.         palette_flag: byte;
  401.         version: word;
  402.  
  403. procedure CLEANUP;
  404.  
  405. begin
  406. close(pcxfile);
  407. freemem(scratch, buffsize);
  408. end;
  409.  
  410. begin    { READ_PCX256 }
  411. assign(pcxfile, pfilename);
  412. {$I-} reset(pcxfile, 1);  {$I+}
  413. file_error:= (IOresult <> 0);
  414. if file_error then exit;
  415. getmem(scratch, buffsize);                  { Allocate scratchpad }
  416. blockread(pcxfile, version, 2);             { Read first two bytes }
  417. file_error:= (hi(version) < 5);             { No palette info. }
  418. if file_error then
  419. begin
  420.   cleanup; exit;
  421. end;
  422. palette_start:= filesize(pcxfile) - 769;
  423.  
  424. seek(pcxfile, 128);                        { Scrap file header }
  425. total_read:= 128;
  426.  
  427. repeatcount:= 0;                           { Initialize assembler vars. }
  428. video_index:= 0;
  429.  
  430. repeat
  431.   blockread(pcxfile, scratch^, buffsize, datalength);
  432.   inc(total_read, datalength);
  433.   if (total_read > palette_start) then
  434.       dec(datalength, total_read - palette_start);
  435.   decode_pcx256;
  436. until (eof(pcxfile)) or (total_read>= palette_start);
  437.  
  438. seek(pcxfile, palette_start);
  439. blockread(pcxfile, palette_flag, 1);
  440. file_error:= (palette_flag <> 12);
  441. if file_error then
  442. begin
  443.   cleanup; exit;
  444. end;
  445. blockread(pcxfile, RGB256, 768);         { Get palette info. }
  446. for x:= 0 to 255 do
  447. with RGB256[x] do
  448. begin
  449.   redval:= redval shr 2;
  450.   greenval:= greenval shr 2;
  451.   blueval:= blueval shr 2;
  452. end;
  453. cleanup;
  454. end;  { READ_PCX256 }
  455.  
  456. { ========================== Initialization ============================= }
  457.  
  458. BEGIN
  459. page_addr:= page0;                      { Destination for EGA/VGA data }
  460. END.
  461.